perm filename INDAT4.SAI[C,ALS] blob sn#130768 filedate 1974-11-15 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00005 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	ENTRY PREPARE
C00005 00003	INTEGER PROCEDURE PEAK (INTEGER LOW,HIGH)
C00008 00004	PROCEDURE FORMANT
C00014 00005	INTERNAL PROCEDURE PREPARE
C00015 ENDMK
C⊗;
ENTRY PREPARE;
BEGIN
DEFINE ⊂="COMMENT",CR="'15",LF="'12",CRLF="CR&LF",TB="'11";
DEFINE ⊃="⊂";	⊂ Used to delete output statements for PLOT;
DEFINE $="⊂";	⊂ Used to delete outstr's;
DEFINE Z="10000%256";
EXTERNAL REAL ARRAY A,C,D[0:512];
⊃ INTERNAL INTEGER ARRAY NEW[0:512];
INTERNAL INTEGER ARRAY INNAME,INDATA[0:32];
EXTERNAL INTEGER ARRAY FVAL[0:8];
INTEGER I,J,K,P,POINTP,NX;
⊃ EXTERNAL INTEGER CHAN5;
INTERNAL INTEGER INFLAG;
INTEGER F1_LOW,F1_HI,F2_LOW,F2_HI,F3_LOW,F3_HI,F4_LOW,F4_HI,F5_LOW;
INTEGER F5_HI,NP_LOW,NP_HI,NZ_LOW,NZ_HI,FP1_LO,FP1_H,FP2_LO,FP2_H;
INTERNAL INTEGER F1,F2,F3,F4,F5,NP,NZ,FP1,FP2,A1,A2,A3,A4,A5;
INTEGER FA,FB,FC,FD,FE;
INTEGER M1,M2,M3,M4,M5;




INTERNAL PROCEDURE DEFINES;
BEGIN
	F1_LOW←  180 * 256%10000;  F1_HI←  850 * 256%10000;
	F2_LOW←  700 * 256%10000;  F2_HI← 2500 * 256%10000;
	F3_LOW← 1570 * 256%10000;  F3_HI← 3400 * 256%10000;
	F4_LOW← 2500 * 256%10000;  F4_HI← 4500 * 256%10000;
	F5_LOW← 3600 * 256%10000;  F5_HI← 5400 * 256%10000;

	M1←	320	* 256%10000;
	M2←	1350	* 256%10000;
	M3←	2800	* 256%10000;
	M4←	3400	* 256%10000;
	M5←	4500	* 256%10000;

	FP1_LO← 1800 * 256%10000;  FP1_H← 3200 * 256%10000;
	FP2_LO← 3200 * 256%10000;  FP2_H← 5000 * 256%10000;


	NP_LOW←  800 * 256%10000;  NP_HI← 1500 * 256%10000;
	NZ_LOW←NP-500* 256%10000;  NZ_HI←NP+500* 256%10000;
END;

INTERNAL PROCEDURE DATOUT;
BEGIN

⊃ ARRYOUT(CHAN5,NEW[0],512);
⊃ POINTP←POINT(9,NEW[1],-1);
NX←0;
 END;



INTEGER PROCEDURE PEAK (INTEGER LOW,HIGH);
BEGIN
  INTEGER I,J,K;  REAL MAX,MIN;

  MAX←-10000; K←LOW;

  FOR I←LOW STEP 1 UNTIL HIGH DO
    IF C[I]>MAX THEN BEGIN  MAX←C[I]; J←I; END;

  IF J=LOW THEN BEGIN
    MAX←-10000; MIN←10000;
    FOR I←LOW STEP 1 UNTIL HIGH DO BEGIN
      IF C[I]>MIN THEN DONE;
      IF C[I]<MIN THEN BEGIN MIN←C[I]; K←I; END;
      END;

    FOR I←K STEP 1 UNTIL HIGH DO
      IF C[I]>MAX THEN BEGIN MAX←C[I]; J←I; END;
    END;

  IF J=HIGH THEN BEGIN
    MAX←-10000; MIN←10000;
    FOR I←HIGH STEP -1 UNTIL K DO BEGIN
      IF C[I]>MIN THEN DONE;
      IF C[I]<MIN THEN MIN←C[I];
      END;

    FOR I←I STEP -1 UNTIL K DO
      IF C[I]>MAX THEN  BEGIN  MAX←C[I]; J←I; END;
    END;

IF J=LOW THEN J←0;    ⊂ No proper peak found;

  RETURN(J);
END;

INTEGER PROCEDURE BAND(INTEGER F);
BEGIN
  INTEGER I,J;

  FOR I←F STEP 1 UNTIL  255 DO IF (C[I]+6)≤C[F] THEN DONE;
⊂  OUTSTR("F="&CVS(F)&TB&"I="&CVS(I)&TB);

  FOR J←F STEP -1 UNTIL 0 DO IF (C[J]+6)≤C[F] THEN DONE;
⊂ OUTSTR("J="&CVS(J)&CRLF);
  IF (F-J)<(I-F) THEN RETURN(F-J) ELSE RETURN(I-F);
END;

INTEGER PROCEDURE REMOVE(INTEGER F,LIMIT);
BEGIN
INTEGER I,J,K;
REAL X,Y,MAX,MIN;

FOR I←F STEP 1 UNTIL LIMIT DO IF C[I]≤C[F]-6 THEN BEGIN J←I; DONE; END;
FOR I←F STEP -1 UNTIL 0 DO IF C[I]≤C[F]-6 THEN BEGIN K←I; DONE; END;
IF ABS(F-K)<ABS(J-F) THEN I←ABS(F-K) ELSE I←ABS(J-F);
X←6.0; X←X/(I*I);
MAX←-10000;
⊂ OUTSTR("I="&CVS(I)&"  ");

FOR I←I+F STEP 1 UNTIL LIMIT DO 
  IF (Y←(C[I]-C[F]+X*(I-F)*(I-F)))>MAX THEN BEGIN MAX←Y; J←I; END;
IF J=LIMIT THEN J←0;

RETURN(J);
END;

PROCEDURE FORMANT;
BEGIN

REAL X,Y;

IF INFLAG=0 THEN BEGIN
⊃     POINTP←POINT(9,NEW[1],-1); NX←0;

	INNAME[P]←CVASC("F1");	P←P+1;
	INNAME[P]←CVASC("F2");	P←P+1;
	INNAME[P]←CVASC("F3");	P←P+1;
	INNAME[P]←CVASC("F4");	P←P+1;
	INNAME[P]←CVASC("F5");	P←P+1;

	INNAME[P]←CVASC("A1");	P←P+1;
	INNAME[P]←CVASC("A2");	P←P+1;
	INNAME[P]←CVASC("A3");	P←P+1;
	INNAME[P]←CVASC("A4");	P←P+1;
	INNAME[P]←CVASC("A5");	P←P+1;

	INNAME[P]←CVASC("B1");	P←P+1;
	INNAME[P]←CVASC("B2");	P←P+1;
	INNAME[P]←CVASC("B3");	P←P+1;
	INNAME[P]←CVASC("B4");	P←P+1;
	INNAME[P]←CVASC("B5");	P←P+1;

  END ELSE BEGIN
$ OUTSTR(CRLF&"⊗ ");

FA←PEAK(0,M1);
F1←PEAK(F1_LOW,F1_HI);
F2←PEAK(F2_LOW,F2_HI);
IF (C[FA]>C[F1])∧(F1=F2) THEN BEGIN
  FB←REMOVE(FA,F1); $ OUTSTR("Voice bar,");
  IF C[FB]>C[F1] THEN BEGIN
    $ OUTSTR("Remove,old F1="&CVS(F1*Z)&",New="&CVS(FA*Z)&TB);
    F1←FA; END;
  END;
IF (F1+3>INDATA[P])∧(F1+4<F2_LOW) THEN F2←PEAK(F2_LOW,F2_HI)
  ELSE BEGIN
    IF INDATA[P]>F2_LOW THEN F2←PEAK(INDATA[P]+1,F2_HI)
      ELSE F2←PEAK(F2_LOW,F2_HI); END;

F3←PEAK(F3_LOW,F3_HI);
F4←PEAK(F4_LOW,F4_HI);
F5←PEAK(F5_LOW,F5_HI);

IF F1=F2 THEN BEGIN
$  OUTSTR("F1=F2="&CVS(F1*10000%256));
  FA←PEAK(F1_LOW,F1);
  IF FA=0 THEN X←0 ELSE X←C[FA];
  FB←PEAK(F2,F2_HI);
  IF FB=0 THEN Y←0 ELSE Y←C[FB];
  IF (X>Y)∧((X+6)>C[F1]) THEN F1←FA ELSE F2←FB;
$ OUTSTR("FA="&CVS(FA*Z)&","&CVF(X)&"FB="&CVS(FB*Z)&","&CVF(Y)&TB);
  END;

IF F2=0 THEN BEGIN
  F2←REMOVE(F1,F2_HI);
$ OUTSTR("REMOVE ");
  END;
IF F2<F2_LOW THEN F2←INDATA[P+1];

IF (F2+4) < F3_LOW THEN F3←PEAK(F3_LOW-2,F3_HI)
  ELSE F3←PEAK(F3_LOW,F3_HI);

IF F2=F3 THEN BEGIN
$  OUTSTR("F2=F3="&CVS(F3*10000%256));
  FC←PEAK(F3,F3_HI);
  IF FC=0 THEN Y←0 ELSE Y←C[FC];
  IF F1>F2_LOW THEN FB←PEAK(F1,F3) ELSE FB←PEAK(F2_LOW,F3);
  IF FB=0 THEN X←0 ELSE X←C[FB];
  IF (Y+6>X)∧((Y+24)>C[F3]) THEN F3←FC ELSE F2←FB;
$ OUTSTR("FB="&CVS(FB*Z)&","&CVS(X)&"FC="&CVS(FC*Z)&","&CVF(Y)&TB);
  END;

IF ((C[F2]+24)<C[F1])∧(F1>F2_LOW) THEN BEGIN
  IF F3>F2_HI THEN FB←REMOVE(F1,F2) ELSE FB←REMOVE(F1,F2_HI);
  IF FB←0 THEN X←0 ELSE X←C[FB];
  IF X>C[F2] THEN F2←FB;
  END;

IF F3=F4 THEN BEGIN
$  OUTSTR("F3=F4="&CVS(F4*10000%256));
  FD←PEAK(F4,F4_HI);
  IF FD=0 THEN Y←0 ELSE Y←C[FD];
  IF F2>F3_LOW THEN FC←PEAK(F2,F4) ELSE FC←PEAK(F3_LOW,F4);
  IF FC=0 THEN X←0 ELSE X←C[FC];
  IF Y+12≥X THEN F4←FD ELSE F3←FC;
$ OUTSTR("FC="&CVS(FC*Z)&","&CVS(X)&"FD="&CVS(FD*Z)&","&CVF(Y)&TB);
  END;

IF F4=F5 THEN BEGIN
$ OUTSTR("F4=F5="&CVS(F5*10000%256));
  FE←PEAK(F5,F5_HI);
  IF FE=0 THEN Y←0 ELSE Y←C[FE];
  IF F3>F4_LOW THEN FD←PEAK(F3,F5) ELSE FD←PEAK(F4_LOW,F5);
  IF FD=0 THEN X←0 ELSE X←C[FD];
  IF Y+12≥X THEN F5←FE ELSE F4←FD;
$ OUTSTR("FD="&CVS(FD*Z)&","&CVS(X)&"FE="&CVS(FE*Z)&","&CVF(Y)&TB);
  END;

$ OUTSTR(CRLF&TB&CVS(F1*Z)&","&CVS(F2*Z)&","&CVS(F3*Z)&","&CVS(F4*Z)
      &","&CVS(F5*Z)&TB&CVF(C[F1])&","&CVF(C[F2])&","&CVF(C[F3])&","&
      CVF(C[F4])&","&CVS(C[F5])&CRLF);

	INDATA[P]←F1;		P←P+1;
	INDATA[P]←F2;		P←P+1;
	INDATA[P]←F3;		P←P+1;
	INDATA[P]←F4;		P←P+1;
	INDATA[P]←F5;		P←P+1;
	INDATA[P]←C[F1];	P←P+1;
	INDATA[P]←C[F2];	P←P+1;
	INDATA[P]←C[F3];	P←P+1;
	INDATA[P]←C[F4];	P←P+1;
	INDATA[P]←C[F5];	P←P+1;

	INDATA[P]←BAND(F1)*10000%256;	P←P+1;
	INDATA[P]←BAND(F2)*10000%256;	P←P+1;
	INDATA[P]←BAND(F3)*10000%256;	P←P+1;
	INDATA[P]←BAND(F4)*10000%256;	P←P+1;
	INDATA[P]←BAND(F5)*10000%256;	P←P+1;
  END;
END;

INTERNAL PROCEDURE PREPARE;
BEGIN

  P←0;

  FORMANT;


⊃ IF INFLAG≠0 THEN BEGIN
⊃   NEW[NX]←FVAL[4];
⊃     FOR I←0 STEP 1 UNTIL 27 DO  IDPB(INDATA[I],POINTP);
⊃     FOR I←1 STEP 1 UNTIL 4 DO IBP(POINTP);
⊃   NX←NX+8;
⊃   IF NX≥512 THEN DATOUT; 
⊃   END;

END;

END;